---
title: "Mario Kart Time Trial PBs"
output:
  flexdashboard::flex_dashboard:
    orientation: rows
    theme: sandstone
    navbar:
      - { title: "Speedruns", href: "sr.html", align: right}
      - { icon: "fas fa-home", href: "index.html", align: right}
    favicon: favicon.png
    source_code: embed
---

<script>
$(document).ready(function(){
    $('[data-toggle="popover"]').popover(); 
});
</script>

```{r lib}
library(tidyverse)
library(flexdashboard)
library(rvest)
library(plotly)
library(lubridate)
library(knitr)
library(kableExtra)
library(DT)
library(emojifont)
```

```{r scrapeWRs}
# Use rvest to scrape WR leaderboard
html <- read_html("http://www.mkwrs.com/mk8dx/wrs.php")

wr0 <- html %>% html_elements(".wr") %>% html_table() %>% .[[1]] %>% 
  rename_with(tolower, everything()) %>% 
  select(track, total = `time+video`, player, date) %>% 
  filter(track != "Total:") %>% 
  mutate(total = str_replace_all(total, "'", ":"),
         total = str_replace_all(total, "\"", "."))

# Labels for violin plot (player name & date). Supports ties.
wr_label <- wr0 %>%
  group_by(track) %>%
  mutate(label = paste0(player, " (", date, ")"),
         n = row_number()) %>%
  ungroup() %>%
  select(-c(player, date)) %>%
  pivot_wider(names_from = n,
              values_from = label,
              names_prefix = "lab_") %>%
  unite("label",
        starts_with("lab_"),
        sep = " &<br>",
        na.rm = TRUE) %>% 
  mutate(label = paste0("<b>", total, "<b><br>", label)) %>% 
  select(-total)

# Use to join w/ other data & compare
wr <- wr0 %>% 
  select(track, WR_total = total) %>%
  mutate(WR_total = ms(WR_total)) %>% 
  distinct()

rm(html, wr0)
```


```{r import}
abr <- read_csv("_data/abr.csv") %>%
  mutate(track = ifelse(!is.na(source), paste(source, short), short)) %>%
  select(trkNO, trk, track, cup, type) %>%
  mutate(track = fct_inorder(track),
         cup = fct_inorder(cup))

ctrk <- abr$track
ccup <- unique(abr$cup)

tt <- read_csv("_data/time-trials.csv",
               col_types = cols(total = "c")) %>%
  filter(cc == 150) %>%
  left_join(abr, by = "trk") %>%
  select(-c(cc, trk, starts_with("lap"))) %>%
  mutate(
    total = ms(total),
    yr = year(date),
    mth = month(date),
    wk = week(date) - 4,
    day = day(date),
    hour = hour(time),
    min = minute(time),
    dt = make_datetime(
      year = yr,
      month = mth,
      day = day,
      hour = hour,
      min = min
    )
  ) %>%
  select(trkNO:type, total, date, dt, yr, wk) %>%
  arrange(track, dt) %>%
  group_by(track) %>%
  mutate(
    improve = round(as.double(lag(total) - total, units = "secs"), 3),
    improve = replace_na(improve, 0),
    cumsum = cumsum(improve)
  ) %>%
  ungroup()

tt_PB <- tt %>%
  select(track, total, dt) %>%
  group_by(track) %>%
  slice_max(dt) %>%
  ungroup() %>%
  left_join(wr, by = "track") %>%
  mutate(WR_diff = round(as.double(total - WR_total, units = "secs"), 3))

tt_all <- tt %>%
  left_join(tt_PB, by = c("track", "total", "dt")) %>%
  mutate(track = factor(track, levels = ctrk))

wk_now <- as_tibble_col(1:(week(today()) - 4)) 
```

# Tracks 1-48 

```{r}
tt_48 <- tt_all %>% 
  filter(trkNO < 49) %>% 
  group_by(track) %>% 
  mutate(sd = sd(total)) %>% 
  ungroup()
```

## Value Boxes

```{r}
v_worst_48 <- slice_max(tt_48, WR_diff)
v_best_48 <- slice_min(tt_48, WR_diff)
v_new_48 <- slice_max(tt_48, dt)
v_old_48 <- slice_min(tt_48, dt)
```

### Best Track (`r v_best_48$WR_diff`S from WR)

```{r}
valueBox(value = v_best_48$track, 
         icon = "fa fa-splotch") 
```

### Worst Track (`r v_worst_48$WR_diff`S from WR)

```{r}
valueBox(value = v_worst_48$track, 
         icon = "fa fa-poo") 
```

### Most Recent PB (Set on `r v_new_48$date`)

```{r}
valueBox(value = v_new_48$track, 
         icon = "fa fa-hourglass-start") 
```

### Oldest PB (Set on `r v_old_48$date`)

```{r}
valueBox(value = v_old_48$track, 
         icon = "fa fa-hourglass-end") 
```

## Graphs

```{r}
PBs <- count(tt_48)
  
tt_48_wk <- tt_48 %>% 
  group_by(wk) %>% 
  mutate(n = n(),
         th = sum(improve * n),
         wmean = th / PBs$n) %>% 
  ungroup() %>% 
  select(wk, wmean, n) %>% 
  distinct() %>% 
  full_join(wk_now, by = c("wk" = "value")) %>% 
  mutate(across(2:3, ~ replace_na(.x, 0))) %>% 
  arrange(wk)
```

### PBs by Week

```{r}
gg_48_wk <- tt_48_wk %>% 
  ggplot() +
  geom_line(aes(x=wk, y=n), color = "#ecc371") +
  theme_minimal() +
  labs(y = "",
       x = "Week")

ggplotly(gg_48_wk)
```

### Weighted Average Improvement by Week

```{r}
gg_48_wk_wt <- tt_48_wk %>% 
  ggplot(aes(x=wk, y=wmean)) +
  geom_line(color = "#85a1ac") +
  theme_minimal() + 
  labs(x = "Week",
       y = "Improvement (secs)")

ggplotly(gg_48_wk_wt)
```

> Improvement for each track weighted by percent of PBs that week compared to total.

### Cumulative Improvement

```{r}
gg_cts_48 <- tt_48 %>% 
  filter(improve != 0) %>% 
  arrange(dt) %>% 
  mutate(cumsum = cumsum(improve)) %>% 
  ggplot(aes(x=dt, y=cumsum)) +
  geom_step(color = "#6868ac") +
  theme_minimal() +
  labs(x="", y="Improvement (secs)") +
  theme(axis.text.x = element_text(angle = 90),
        legend.position = "none")

ggplotly(gg_cts_48)
```

## Violin

### PB Time Distributions, Feb 01, 2022 - Present

```{r violin48, fig.height=10}
gg_48 <- tt_48 %>% 
  filter(track != "GCN Baby Park") %>% 
  ggplot(aes(factor(track), total)) +
  geom_violin(draw_quantiles = 0.5, 
              scale = "width",
              aes(fill = sd, color=sd),
              alpha = .7) + 
  stat_summary(fun = "mean", geom = "crossbar", size = .2, aes(color = sd)) +
  stat_summary(fun = "median", geom = "point", size = .4) +
  geom_text(aes(factor(track), WR_total), 
            label = emoji("trophy"), 
            family = 'EmojiOne',
            size = 3) +
  scale_fill_gradient(low = "darkcyan", high = "plum") +
  scale_color_gradient(low = "darkcyan", high = "plum") +
  scale_y_time() +
  scale_x_discrete() +
  labs(x = "",
       y = "") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45,
                                   hjust = 0.98,
                                   vjust = 0.9),
        axis.text = element_text(size = 8),
        axis.ticks = element_line(size = .2),
        panel.grid = element_line(size = .2),
        panel.border = element_rect(fill = NA, size = .2),
        legend.position = "none")

ggplotly(gg_48)
```

# Tracks 49-96 

```{r}
tt_96 <- tt_all %>% 
  filter(trkNO > 48) %>% 
  group_by(track) %>% 
  mutate(sd = sd(total)) %>% 
  ungroup()
```

## Value Boxes

```{r}
v_worst_96 <- slice_max(tt_96, WR_diff)
v_best_96 <- slice_min(tt_96, WR_diff)
v_new_96 <- slice_max(tt_96, dt)
v_old_96 <- slice_min(tt_96, dt)
```

### Best Track (`r v_best_96$WR_diff`S from WR)

```{r}
valueBox(value = v_best_96$track, 
         icon = "fa fa-splotch") 
```

### Worst Track (`r v_worst_96$WR_diff`S from WR)

```{r}
valueBox(value = v_worst_96$track, 
         icon = "fa fa-poo") 
```

### Most Recent PB (Set on `r v_new_96$date`)

```{r}
valueBox(value = v_new_96$track, 
         icon = "fa fa-hourglass-start") 
```

### Oldest PB (Set on `r v_old_96$date`)

```{r}
valueBox(value = v_old_96$track, 
         icon = "fa fa-hourglass-end") 
```

## Graphs {data-width=330}

```{r}
PBs_96 <- count(tt_96)

wk_now_96 <- wk_now %>% 
  filter(value > 6)

tt_96_wk <- tt_96 %>% 
  group_by(wk) %>% 
  mutate(n = n(),
         wt = n / PBs_96$n,
         wmean = sum(improve * wt)) %>% 
  ungroup() %>% 
  select(wk, wmean, n) %>% 
  distinct() %>% 
  full_join(wk_now_96, by = c("wk" = "value")) %>% 
  mutate(across(2:3, ~ replace_na(.x, 0))) %>% 
  arrange(wk)
```

### PB Count by Week

```{r}
gg_96_wk <- tt_96_wk %>% 
  ggplot() +
  geom_line(aes(x=wk, y=n), color = "#ecc371") +
  theme_minimal() +
  labs(y = "",
       x = "")

ggplotly(gg_96_wk)
```

### Weighted Average Improvement by Week

```{r}
gg_96_wk_wt <- tt_96_wk %>% 
  ggplot(aes(x=wk, y=wmean)) +
  geom_line(color = "#85a1ac") +
  theme_minimal() + 
  labs(x = "",
       y = "Improvement")

ggplotly(gg_96_wk_wt)
```

> Improvement for each track weighted by percent of PBs that week compared to total.

### Cumulative Improvement

```{r}
gg_cts_96 <- tt_96 %>% 
  filter(improve != 0) %>% 
  arrange(dt) %>% 
  mutate(cumsum = cumsum(improve)) %>% 
  ggplot(aes(x=dt, y=cumsum)) +
  geom_step(color = "#6868ac") +
  theme_minimal() +
  labs(x="", y="Improvement (secs)") +
  theme(axis.text.x = element_text(angle = 90),
        legend.position = "none")

ggplotly(gg_cts_96)
```

## Violin

### PB Time Distributions

```{r violin96, fig.height=10}
gg_96 <- tt_96 %>% 
  group_by(track) %>% 
  mutate(sd = sd(total)) %>% 
  ungroup() %>% 
  ggplot(aes(factor(track), total)) +
  geom_violin(draw_quantiles = 0.5, 
              scale = "width",
              aes(fill = sd, color=sd),
              alpha = .7) + 
  stat_summary(fun = "mean", geom = "crossbar", size = .2, aes(color = sd)) +
  stat_summary(fun = "median", geom = "point", size = .4) + 
  geom_text(aes(factor(track), WR_total), 
            label = emoji("trophy"), 
            family = 'EmojiOne',
            size = 3) +
  scale_fill_gradient(low = "darkcyan", high = "plum") +
  scale_color_gradient(low = "darkcyan", high = "plum") +
  scale_y_time() +
  scale_x_discrete() +
  labs(x = "",
       y = "") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45,
                                   hjust = 0.98,
                                   vjust = 0.9),
        axis.text = element_text(size = 8),
        axis.ticks = element_line(size = .2),
        panel.grid = element_line(size = .2),
        panel.border = element_rect(fill = NA, size = .2),
        legend.position = "none")

ggplotly(gg_96)
```

# Tables {data-orientation=columns}

## Current PBs {.tabset data-width=500}

```{r}
tt_tbl <- tt_all %>%
  select(trkNO, cup, track, date, total, improve, WR_total, WR_diff) %>% 
  select(-trkNO)

PB_tbl <- tt_tbl %>% 
  filter(!is.na(WR_total)) %>% 
  select(-improve)
```

### Current PBs 

```{r}
PB_tbl %>% 
  kbl(
    col.names = c(" ", "Track", "PB Date", "PB", "WR", "WR Diff"),
    align = "c",
    escape = FALSE,
    longtable = TRUE
  ) %>% 
  kable_styling(full_width = TRUE) %>%
  column_spec(column = 1,
              extra_css = 'transform: rotate(270deg);') %>%
  column_spec(3:4,
              extra_css = 'font-size: 80%;') %>%
  column_spec(
    6,
    color = "white",
    background = spec_color(
      PB_tbl$WR_diff,
      begin = 0.3,
      end = 0.7,
      alpha = 0.7,
      option = "A"
    ),
    popover = paste0("WR: ", PB_tbl$WR_total)
  ) %>%
  remove_column(5) %>%
  collapse_rows(columns = 1,
                row_group_label_position = 'stack') %>%
  row_spec(0, align = "c")
```

## All Records {.tabset}

### All Records

```{r}
tt_tbl %>%
  select(-WR_total) %>%
  mutate(total = paste(total),
         improve = ifelse(improve == 0, NA, improve)) %>%
  arrange(desc(WR_diff)) %>%
  datatable(
    rownames = FALSE,
    colnames = c("Cup", "Track", "PB Date", "PB",
                 "Improvement", "WR Diff"),
    filter = 'top',
    options = list(pageLength = 48,
                   autoWidth = TRUE,
                   columnDefs = list(
                     list(className = 'dt-center', targets = 0:3)
                   ))
  ) %>%
  formatStyle(3:6, `font-size` = '80%') 
```